home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of Shareware
/
Best of PC Windows Shareware 1.0 - Wayzata Technology (7111) (1993).iso
/
mac
/
DOS
/
UTILITY
/
MXMNU238
/
GRID.INC
< prev
next >
Wrap
Text File
|
1991-12-19
|
8KB
|
334 lines
Comment
==========================================================
This include file exports definitions that create a block menu look and
feel. This is one of several look and feel files that export the same
procedures.
Useful Routines Exported:
LookSetup
Call this to initialize the screen. Set MenuTitle and StatusLineText
before calling this routine.
CornerStretchBox (Header,Col,Row)
Creates a window from the array Choices with the upper left corner at
Row/Col. LastKey is set to the letter that is chosen.
CenterStretchBox (Header,Col,Row)
Creates a window from the array Choices with the center at Row/Col.
if a 0 is passed for either the Row or Col then the center of the
screen is assumed. LastKey is set to the letter that is chosen.
Leave
Puts up an exit box.
==========================================================
EndComment
var
VertLine = "┬││││││││││││││││││││││││││││││││││││││││││││││││││││││││││││"
VertLine2 = "││││││││││││││││││││││││││││││││││││││││││││││││││││││││││││"
VertLine3 = "┌─┴┴┴┴─┐"
VertLine4 = "└─┬┬┬┬─┘"
Grid1 = "╠═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╬═╣"
Grid2 = "├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤"
Grid3 = "╠╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╬╣"
Grid4 = "├┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┤"
Choices
MenuTitle
StatusLineText
HeightDifference
Greek = False
var
BackGroundFG
BackGroundBG
TitleBoxBorderFG
TitleBoxBG
TitleBoxInsideFG
ClockColorFG
StatusLineFG
StatusLineBG
MenuInsideFG
MenuBG
MenuHeaderFG
MenuHeaderBG
MenuBorderFG
MenuVertLinesFG
MenuInverseFG
MenuInverseBG
MenuCapColorFG
ConsoleInsideFG
GreekFG
GreekBG
;------ This is where you set your favorite colors.
Procedure SetColors
if ColorScreen
BackGroundFG = LBlue
BackGroundBG = Black
TitleBoxBG = Brown
TitleBoxBorderFG = White
TitleBoxInsideFG = Yellow
ClockColorFG = Yellow
StatusLineFG = Yellow
StatusLineBG = Mag
MenuBG = Black
MenuInsideFG = Yellow
MenuBorderFG = LRed
MenuHeaderFG = White
MenuHeaderBG = Green
MenuVertLinesFG = LGreen
MenuInverseFG = Yellow
MenuInverseBG = Mag
MenuCapColorFG = White
ConsoleInsideFG = White
GreekFG = Black
GreekBG = Brown
else
BackGroundFG = Grey
BackGroundBG = Black
TitleBoxBG = Grey
TitleBoxBorderFG = Black
TitleBoxInsideFG = Black
ClockColorFG = Black
StatusLineFG = Black
StatusLineBG = Grey
MenuBG = Black
MenuInsideFG = Grey
MenuBorderFG = White
MenuHeaderFG = Black
MenuHeaderBG = Grey
MenuVertLinesFG = White
MenuInverseFG = Black
MenuInverseBG = Grey
MenuCapColorFG = White
ConsoleInsideFG = Grey
GreekFG = Black
GreekBG = Grey
endif
EndProc
;------ Sets up main window to block look.
Procedure LookSetup
if MenuInsideFG = 0 then SetColors
NoExit
;------ Clear the screen with a textured background
TextColor BackGroundFG BackGroundBG
ClearScreen
GotoXY 1 3
loop ScreenHeight - 3
Writeln Grid3
endloop
;------ If Greek is true then draw greek columns
; if Greek then GreekColumns
;------ Draw Status Line
NoBoxBorder
Explode Off
BoxInsideColor StatusLineFG StatusLineBG
DrawBox 1 ScreenHeight ScreenWidth 1
WriteCenter(StatusLineText)
;------ Draw the Title Box
SingleLineBox
Explode Off
BoxInsideColor TitleBoxInsideFG TitleBoxBG
BoxBorderColor TitleBoxBorderFG TitleBoxBG
DrawBox 1 1 ScreenWidth 3
GotoXY(ScreenWidth - Length(MenuTitle) - 3,1)
Write MenuTitle
;------ Display the clock
ClockColor ClockColorFG TitleBoxBG
ClockPos 3 2
;------ Setup Console
ConsolePos 42 5
ConsoleHeaderColor MenuInverseFG MenuInverseBG
ConsoleInsideColor ConsoleInsideFG MenuBG
BoxHeaderColor MenuHeaderFG MenuHeaderBG
HeightDifference = 2
SmallShadow
Shadow
EndProc
Procedure CenterStretchBox (Header,Col,Row)
MakeBox(Header,Col,Row,True)
EndProc
Procedure CornerStretchBox (Header,Col,Row)
MakeBox(Header,Col,Row,False)
EndProc
Procedure MakeBox(Header,Col,Row,Center)
var NumElem Height Width
Width = Length(Header) + 1
NumElem = NumberOfElements(Choices)
;Get the widest element in the Choices Array
if Length(Choices[1]) > 0
loop NumElem
Trim(Choices[LoopIndex])
Choices[LoopIndex] = " " + Char(64 + LoopIndex) + ". " + Choices[LoopIndex]
Width = Max(Width,Length(Choices[LoopIndex]))
endloop
else
Width = ScreenWidth - 9
endif
Height = NumElem + 2
Width = Width + 5
if Center
if Row = 0
;Center window verticaly
Row = ((ScreenHeight - Height) / 2) + 2
else
;Center window with X Coordinate
Row = (Row - (Height / 2) + 1)
endif
if Col = 0
;Center window horizonitly
Col = (ScreenWidth - Width) / 2 + 1
else
;Center window with Y Coordinate
Col = (Col - (Width / 2) + 1)
endif
endif
;Make Sure Row and Col are within their range
Row = Max(Row,5)
Row = Min(Row,ScreenHeight - Height - 2)
Col = Max(Col,2)
Col = Min(Col,ScreenWidth - Width - 2)
DrawTheBox(Col,Row,Width,Height,Header)
;Write the menu choices
loop(NumElem - 1)
Writeln(Choices[LoopIndex])
endloop
Write Choices[NumElem]
UseArrows On
Dispose(Choices)
EndProc
;------ Draw the Box
Procedure DrawTheBox (Col,Row,Width,Height,Header)
;Draw the main window
DoubleLineBox
InActiveBox SingleLineBox
BoxInsideColor(MenuInsideFG,MenuBG)
BoxBorderColor(MenuBorderFG,MenuBG)
if Header > '' then Header = ' ' + Header + ' '
BoxHeader = Header
DrawBox(Col, Row, Width, Height)
if Header > ''
TextColor MenuInsideFG MenuBG
CapsColor(MenuCapColorFG,MenuBG)
InverseColor(MenuInverseFG,MenuInverseBG)
Window(Col + 2, Row + 1, Width - 4, Height - 2)
else
CapsColor Black Black
endif
EndProc
;------ MenuExit Procedure
Procedure LeaveMenu
AppendArray(Choices,'Yes')
AppendArray(Choices,'No')
CenterStretchBox ('Exit Menu',0,0)
OnScreenOnly Off
OnKey "A"
|ExitMenu
OnKey "B"
|LastKey = Esc
OnKey "Y"
|ExitMenu
OnKey "N"
|LastKey = Esc
EndProc
;------ Read a Text Line Procedure
Procedure ReadTextLine(St,Header,Col,Row)
var AnswerLine
Choices[1] = ""
CenterStretchBox(Header,Col,Row)
Write " " St " "
TextColor(MenuCapColorFG,MenuBG)
AnswerLine = Readln
EraseTopWindow
Dispose Choices
Return AnswerLine
EndProc
Procedure GreekColumns
TextColor GreekFG GreekBG
GotoXY 4,4
WriteVertical VertLine2
GotoXY 5,4
WriteVertical VertLine2
GotoXY 6,4
WriteVertical VertLine2
GotoXY 7,4
WriteVertical VertLine2
GotoXY ScreenWidth - 6,4
WriteVertical VertLine2
GotoXY ScreenWidth - 5,4
WriteVertical VertLine2
GotoXY ScreenWidth - 4,4
WriteVertical VertLine2
GotoXY ScreenWidth - 3,4
WriteVertical VertLine2
GotoXY 2,4
Write VertLine4
GotoXY ScreenWidth - 8,4
Write VertLine4
GotoXY 2,ScreenHeight - 1
Write VertLine3
GotoXY ScreenWidth - 8,ScreenHeight - 1
Write VertLine3
EndProc